import Utility.Directory
import Utility.Exception
import Utility.Monad
-import Utility.FileSystemEncoding
import Utility.SystemDirectory
+import Utility.OsPath
import qualified Utility.RawFilePath as R
import Utility.PartialPrelude
+import qualified Utility.OsString as OS
import System.IO
import Data.List
import Control.Monad
import Control.Monad.IfElse
import qualified Data.Map as M
-import qualified Data.ByteString as S
-import System.FilePath.ByteString
import Control.Applicative
import Prelude
, return r
)
where
- dotgit = w </> ".git"
+ dotgit = w </> literalOsPath ".git"
- replacedotgit = whenM (doesFileExist (fromRawFilePath dotgit)) $ do
+ replacedotgit = whenM (doesFileExist dotgit) $ do
linktarget <- relPathDirToFile w d
- removeWhenExistsWith R.removeLink dotgit
- R.createSymbolicLink linktarget dotgit
+ let dotgit' = fromOsPath dotgit
+ removeWhenExistsWith R.removeLink dotgit'
+ R.createSymbolicLink (fromOsPath linktarget) dotgit'
-- Unsetting a config fails if it's not set, so ignore failure.
unsetcoreworktree = void $ Git.Config.unset "core.worktree" r
- worktreefixup =
+ worktreefixup = do
-- git-worktree sets up a "commondir" file that contains
-- the path to the main git directory.
-- Using --separate-git-dir does not.
- catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d </> "commondir"))) >>= \case
+ let commondirfile = fromOsPath (d </> literalOsPath "commondir")
+ catchDefaultIO Nothing (headMaybe . lines <$> readFile commondirfile) >>= \case
Just gd -> do
-- Make the worktree's git directory
-- contain an annex symlink to the main
-- repository's annex directory.
- let linktarget = toRawFilePath gd </> "annex"
- R.createSymbolicLink linktarget
- (dotgit </> "annex")
+ let linktarget = toOsPath gd </> literalOsPath "annex"
+ R.createSymbolicLink (fromOsPath linktarget) $
+ fromOsPath $ dotgit </> literalOsPath "annex"
Nothing -> return ()
-- Repo adjusted, so that symlinks to objects that get checked
needsSubmoduleFixup :: Repo -> Bool
needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
- (".git" </> "modules") `S.isInfixOf` d
+ (literalOsPath ".git" </> literalOsPath "modules") `OS.isInfixOf` d
needsSubmoduleFixup _ = False
needsGitLinkFixup :: Repo -> IO Bool
-- Optimization: Avoid statting .git in the common case; only
-- when the gitdir is not in the usual place inside the worktree
-- might .git be a file.
- | wt </> ".git" == d = return False
- | otherwise = doesFileExist (fromRawFilePath (wt </> ".git"))
+ | wt </> literalOsPath ".git" == d = return False
+ | otherwise = doesFileExist (wt </> literalOsPath ".git")
needsGitLinkFixup _ = return False
import Utility.Debug
import Utility.DebugLocks
import Utility.InodeCache
+import Utility.OsPath
import Database.Persist.Sqlite
import qualified Database.Sqlite as Sqlite
{- A DbHandle is a reference to a worker thread that communicates with
- the database. It has a MVar which Jobs are submitted to.
- There is also an MVar which it will fill when there is a fatal error-}
-data DbHandle = DbHandle RawFilePath (Async ()) (MVar Job) (MVar String)
+data DbHandle = DbHandle OsPath (Async ()) (MVar Job) (MVar String)
{- Name of a table that should exist once the database is initialized. -}
type TableName = String
{- Opens the database, but does not perform any migrations. Only use
- once the database is known to exist and have the right tables. -}
-openDb :: RawFilePath -> TableName -> IO DbHandle
+openDb :: OsPath -> TableName -> IO DbHandle
openDb db tablename = do
jobs <- newEmptyMVar
errvar <- newEmptyMVar
| ChangeJob (SqlPersistM ())
| CloseJob
-workerThread :: RawFilePath -> TableName -> MVar Job -> MVar String -> IO ()
+workerThread :: OsPath -> TableName -> MVar Job -> MVar String -> IO ()
workerThread db tablename jobs errvar = newconn
where
newconn = do
- retrying only if the database shows signs of being modified by another
- process at least once each 30 seconds.
-}
-runSqliteRobustly :: TableName -> RawFilePath -> (SqlPersistM a) -> IO a
+runSqliteRobustly :: TableName -> OsPath -> (SqlPersistM a) -> IO a
runSqliteRobustly tablename db a = do
conn <- opensettle maxretries emptyDatabaseInodeCache
go conn maxretries emptyDatabaseInodeCache
opensettle retries ic = do
#if MIN_VERSION_persistent_sqlite(2,13,3)
- conn <- Sqlite.open' db
+ conn <- Sqlite.open' (fromOsPath db)
#else
- conn <- Sqlite.open (T.pack (fromRawFilePath db))
+ conn <- Sqlite.open (T.pack (fromOsPath db))
#endif
settle conn retries ic
, BaseBackend backend ~ SqlBackend
, BackendCompatible SqlBackend backend
)
- => RawFilePath
+ => OsPath
-> (LogFunc -> IO backend)
-> (backend -> m a)
-> m a
, BaseBackend backend ~ SqlBackend
, BackendCompatible SqlBackend backend
)
- => RawFilePath
+ => OsPath
-> backend
-> IO ()
closeRobustly db conn = go maxretries emptyDatabaseInodeCache
=> String
-> err
-> Int
- -> RawFilePath
+ -> OsPath
-> Int
-> DatabaseInodeCache
-> (Int -> DatabaseInodeCache -> IO a)
else giveup (databaseAccessStalledMsg action db err)
else a retries' ic
-databaseAccessStalledMsg :: Show err => String -> RawFilePath -> err -> String
+databaseAccessStalledMsg :: Show err => String -> OsPath -> err -> String
databaseAccessStalledMsg action db err =
- "Repeatedly unable to " ++ action ++ " sqlite database " ++ fromRawFilePath db
+ "Repeatedly unable to " ++ action ++ " sqlite database " ++ fromOsPath db
++ ": " ++ show err ++ ". "
++ "Perhaps another git-annex process is suspended and is "
++ "keeping this database locked?"
emptyDatabaseInodeCache :: DatabaseInodeCache
emptyDatabaseInodeCache = DatabaseInodeCache Nothing Nothing
-getDatabaseInodeCache :: RawFilePath -> IO DatabaseInodeCache
+getDatabaseInodeCache :: OsPath -> IO DatabaseInodeCache
getDatabaseInodeCache db = DatabaseInodeCache
<$> genInodeCache db noTSDelta
- <*> genInodeCache (db <> "-wal") noTSDelta
+ <*> genInodeCache (db <> literalOsPath "-wal") noTSDelta
isDatabaseModified :: DatabaseInodeCache -> DatabaseInodeCache -> Bool
isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) =
) where
import Utility.Monad
-import Utility.RawFilePath
import Utility.DebugLocks
import Utility.Exception
+import Utility.OsPath
import Database.Handle
import Database.Persist.Sqlite
{- Opens the database queue, but does not perform any migrations. Only use
- if the database is known to exist and have the right tables; ie after
- running initDb. -}
-openDbQueue :: RawFilePath -> TableName -> IO DbQueue
+openDbQueue :: OsPath -> TableName -> IO DbQueue
openDbQueue db tablename = DQ
<$> openDb db tablename
<*> (newMVar =<< emptyQueue)
import System.Posix.Types
import System.Posix.IO.ByteString
import System.Posix.Files.ByteString
-import System.FilePath.ByteString (RawFilePath)
import Data.Maybe
type LockFile = OsPath
projects / git-annex.git / commitdiff